PsL Monthly 1993 December

home *** CD-ROM | disk | FTP | other *** search

/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / langwn1.exe / SAMPLE05.BAS < prev next >

Wrap

BASIC Source File | 1993-03-20 | 23.4 KB | 644 lines

'============================================================================ '============================================================================ ' this sample has two demos: ' 1) subroutine IntButton illustrates the technique ' of starting a long running task and displaying an interrupt ' button to terminate that task. the "time out" feature of WinEvent is ' used to return control to your code if no events occur in 0.5 seconds. ' 2) subroutine GetScrollDemo illustrates how to dynamically ' add text to a list of scrollable text in a visible window. ' you must start QuickBASIC as follows: qb /ah /L langwin ' /L langwin parameter provides access to LangWin quicklib ' /ah parameter is needed to allow dynamic arrays > 64k. DECLARE SUB IntButton () ' demo of interrupt button technique DECLARE SUB GrowScrollDemo () ' demo of adding text to visible window DECLARE FUNCTION VidType% () ' used to determine type of monitor ' must compile with qb /ah /L langwin '$DYNAMIC make all arrays dynamic DEFINT A-Z '$INCLUDE: 'LANGWIN.BI' ' TYPE, DECLARE and COMMON definitions for LangWin. ' NOTE: LANGWIN.BI contains all definitions found ' in QB.BI, so include for QB.BI is not needed. CLEAR , , 5000 ' set stack at 5000 bytes '--------------------------------------------------------------- ' first see if EGA or VGA monitor mm = VidType IF mm <> 3 AND mm <> 4 THEN ' monitor is not EGA/VGA ' take whatever actions necessary (error messages) BEEP PRINT "LangWin needs EGA or VGA, sorry ........" END END IF '----------------------------------------------------------------- ' get attribute from current screen (row 1, col 1) ' so it can be restored upon exit OrigAttr = SCREEN(1, 1, 1) '------------------------------------------------------------------- ' if WIDTH command is used, it must be placed before call to LangWinInit ' because code in LangWinInit extracts max rows/cols from screen and saves ' in global variables. if WIDTH is used after LangWinInit, the global ' variable will not be set correctly. WIDTH 80, 25 '---------------------------------------------------------------------- ' these variables MUST be defined BEFORE call to LangWinInit. ' keep these as low as possible to conserve memory at run time. MaxWindows = 8 ' max simultaneous open windows MaxButtons = 30 ' max number of objects (incl lines with labels) active MaxTextLines = 35 ' maximum number of text lines in any scrollable win MaxTextWins = 5 ' max windows that can have scrollable text ' must be <= MaxWindows LOCATE , , 0 ' start with hidden text cursor '--------------------------------------------------------------------------- ' LangWin only supports text mode. You MUST call the SCREEN 0 command BEFORE ' the call to LangWinInit. You can call SCREEN with a video page other than 0 ' (i.e., SCREEN 0,,x,x where x is a page number supported by your system). ' Code in LangWinInit will determine which video page you are using and save ' the value in a global variable for use by other LangWin routines. If you ' call SCREEN 0 after LangWinInit and change the original video page, you'll ' get unpredictable results (i.e., LangWin will write to the original video ' page). However, you can use other video pages for functions not associated ' with your LangWin windows; just be sure to set the video page back to the ' original value defined below. SCREEN 0, , 0, 0 ' LangWin ONLY supports text mode ' You MUST call the SCREEN command BEFORE LangWinInit CALL LangWinInit ' initialize (if mouse exists, it will be displayed) ' if you get "subscript out of range" error while ' in this routine, be sure you called QB with /ah. ' then try reducing the value of MaxWindows. ' check the WIDTH command; reduce number of columns, ' and/or number of rows. '----------------------------------------------------------------------- ' display "wallpaper" IF HaveMouse THEN CALL HideMouseCursor ' first hide mouse pointer CLS CALL SetColor(8, 15) FOR i = 1 TO MaxRows LOCATE i, 1 PRINT STRING$(80, 178); ' can try 176, 177, or 178 NEXT IF HaveMouse THEN CALL ShowMouseCursor ' display the mouse pointer '==================================================================== CALL IntButton ' demo of technique to implement an interrupt button CALL GrowScrollDemo ' demo of dynamically growing scrollable list '===================================================================== IF HaveMouse THEN HideMouseCursor ' we're done with the mouse bbb = (OrigAttr AND &HF0) \ 16 ' mask & shift to get original background fff = OrigAttr AND &HF ' mask to get original foreground PALETTE ' restore original palette CALL SetColor(fff, bbb) ' restore orig foreground/background CLS LOCATE , , 1 ' make text cursor visible END REM $STATIC SUB GrowScrollDemo ' this routine shows an example of how you could dynamically ' add text to the bottom of an existing window containing scrollable ' text (using the GrowScrollText function). ' two windows are opened; one with buttons (EXIT, ADD, AUTO) and one ' with scrollable text. ' for each click on ADD button, dynamic text will be manually generated and ' added to the bottom of the visible scrollable text. when the scrollable ' text fills the window, it is scrolled up as new text is added to the bottom. ' clicking the AUTO button will cause text to be automatically added. ' (a STOP button will become active. click it to halt the process; ' else process will halt when array is filled). ' notice that the window to be modified (ie where the scrollable text ' is to be added) MUST be current when GrowScrollText is called. ' i've overlapped the text and buttons windows to show how the ' text window is given focus each time you click ADD to add a new line ' of text. ' this technique could be used if your program searches a file, data base, ' directory, etc. for specific data, and you want to dynamically display ' the extracted info in a scrollable window as the search progresses. ' call GrowScrollText each time a new entry is returned by your search ' routine. this will give the user feedback - they'll see the scrollable text ' growing as new entries are found. ' if you fill up the array (MaxTextLines), then GrowScrollText will ' return a -2 return code. in this case, you'll have to process ' the current array of scrollable text and perhaps give the ' user the option to continue the search (via a button) after ' all extracted data in this pass have been examined, etc. ' create a string array of scrollable text ' but it can be of size 1 since the LangWin structure SaveText ' and not the following array will actually hold the text being grown. DIM Text(1 TO 1) AS STRING ' open a window with scrollable text w1 = OpenScrollWindow(3, 3, 21, 25, 3, 15, 2, 15, Text(), 1, 2, 17, 20, 0, 1) ' open window with control buttons w2 = BlankWin(4, 23, 12, 70, 9, 15, 2, 15, 0, 1) x = ShowWinText(2, 3, 15, "Click ADD to manually add new text") x = ShowWinText(3, 3, 15, "Click AUTO to automatically add new text") ' make buttons. ' save handle numbers in variables. ' these will be used later to determine which button was clicked. xit1 = MakePushButton(5, 3, 6, "EXIT", 15, 4, 1) add1 = MakePushButton(5, 11, 5, "ADD", 15, 4, 1) auto1 = MakePushButton(5, 18, 6, "AUTO", 15, 4, 1) stop1 = MakePushButton(5, 26, 6, "STOP", 15, 4, 1) x = DeactivateButton(stop1, 1) ' deactivate the stop button ' give the exit button focus (if ENTER is hit, EXIT button will be pushed) WinParms(CurWinPtr, 16) = xit1' put handle of exit button into data structure CALL ChangeButtonFocus(xit1, 0) ' reverse video the button to give it focus '------------------------------------------------------------ ' MAIN LOOP ' as long as any win is open ' wait for an event in any window, then process it DO WHILE AnyWinOpen ' wait for an event ' win number (wn) and event code (action) returned wn = WinEvent(action) ' test window number to see which window was current when event occurred SELECT CASE wn CASE w2 ' determine what type of event occurred in the window w1 SELECT CASE action CASE 1 ' close xx = CloseWindow ' close current window (with buttons) xx = CloseWindow ' only text win left, close it EXIT DO CASE 3 ' button ' see which button SELECT CASE WinParms(CurWinPtr, 16) CASE xit1 xx = CloseWindow ' close current window (with buttons) xx = CloseWindow ' only text win left, close it EXIT DO CASE add1 T$ = "Time: " + TIME$ ' define new text ' must give text window focus BEFORE adding text IF IsWinOpen(w1, Han) THEN ' get text win's handle CALL NewFocusWindow(Han) ' give text win focus END IF x = GrowScrollText(T$) ' now add some text ' test for errors SELECT CASE x CASE -1 ' no scrollable text ' process this condition ' usually it means you forgot to ' call NewFocusWindow to give focus to window ' with text to be modified. CASE -2 ' scrollable text array was filled up. ' you'll probably have to activate a "continue" button, ' let the user view the text, and wait for an event. ' when the "continue" button is clicked, ' close the window with the full text array, ' open a new one in its place ' (with no text), and continue generating items ' to be displayed in the scrollable text window. ' for the demo, i'll just make some noise ' to let you know array is full. BEEP END SELECT CASE auto1 ' deactivate EXIT, ADD, and AUTO buttons x = DeactivateButton(xit1, 0) x = DeactivateButton(add1, 0) x = DeactivateButton(auto1, 0) ' activate the stop button x = ActivateButton(stop1, 0) ' must give text window (w1) focus BEFORE adding text. ' get it's handle, save in Han x = IsWinOpen(w1, Han) ' get text win's handle ' loop til STOP clicked or array is filled DO ' must give text window (w1) focus BEFORE adding text. ' window with buttons could be clicked while ' WinEvent has control for 0.5 sec, which would ' take focus away from the text window (w1) and give ' it to the window with buttons (w2). in this case, ' subsequent calls to GrowScrollText would return with ' a -1 return code. to prevent this condition, ' first make sure text window (w1) has focus. CALL NewFocusWindow(Han) ' give text win focus T$ = "Time: " + TIME$ ' define new text x = GrowScrollText(T$) ' now add some text IF x = -2 THEN EXIT DO ' bail out if array is full IF x = -1 THEN BEEP ' this should not occur ' could insert a SLEEP 1 if necessary aa = -999 ' set "time out" option for WinEvent x = WinEvent(aa) ' will return in 0.5 sec if no events occur ' loop until interrupt button is clicked LOOP UNTIL (aa = 3 AND WinParms(CurWinPtr, 16) = stop1) BEEP ' make some noise ' activate EXIT, ADD, and AUTO buttons x = ActivateButton(xit1, 0) x = ActivateButton(add1, 0) x = ActivateButton(auto1, 0) ' deactivate the stop button x = DeactivateButton(stop1, 0) END SELECT ' end of code to process buttons END SELECT ' end of code to process actions in the window END SELECT ' end of code that processes windows LOOP LOCATE 25, 1 CALL SetColor(15, 4) PRINT "HIT ANY KEY TO CONTINUE DEMO ..."; SLEEP LOCATE 25, 1 CALL SetColor(8, 15) PRINT STRING$(80, 178); END SUB ' ' this subroutine illustrates the technique of opening a window, ' starting a long running task in a loop, and implementing an ' interrupt button to terminate the task. ' ' the "time out" option of WinEvent is used in the loop with the long ' running task. after a portion of the task is completed, control ' is given to WinEvent to determine if any actions have occured in ' the window. if an action occurs, WinEvent will return control as usual. ' if no actions occur in 0.5 sec, WinEvent times out and returns control ' to your code. when you get control, test to see if any actions have ' occured. if none, loop and do more work on the task at hand. if ' an action occured (i.e., the interrupt button pressed), then ' terminate the task by exiting the loop. ' SUB IntButton '============================================================= ' main window: text and buttons m1 = BlankWin(9, 26, 21, 69, 9, 15, 1, 0, 1, 1) ' i'll skip the test for an error return code ' display some text in the window d = ShowWinText(1, 2, 15, "Example of 'time out' option in WinEvent") d = ShowWinText(2, 2, 15, "to implement an INTERRUPT button.") d = ShowWinText(4, 2, 15, "Click Test Win button to open window.") d = ShowWinText(5, 2, 15, "Click Start button to begin task.") d = ShowWinText(6, 2, 15, "Click Interrupt button to terminate task.") ' put a title in window d = ShowTitle(" SAMPLE05 ", 15, 4) ' no error tests will done for above functions ' make buttons. ' save handle numbers in variables. ' these will be used later to determine which button was clicked. TestWin = MakePushButton(8, 10, 10, "Test Win", 15, 3, 1) xit2 = MakePushButton(8, 23, 6, "EXIT", 15, 5, 1) ' give the exit button focus (if ENTER is hit, EXIT button will be pushed) WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus '============================================================= ' MAIN LOOP ' as long as any win is open ' wait for an event in any window, then process it DO WHILE AnyWinOpen ' wait for an event ' win number (wn) and event code (action) returned wn = WinEvent(action) ' test window number to see which window was current when event occurred SELECT CASE wn CASE m1 ' main window ' now determine what type of event occurred in the window w2 SELECT CASE action CASE 1 ' close icon or ESC x = CloseWindow CASE 2 ' text ' no scrollable text to select in this win CASE 3 ' button ' determine which button was clicked ' get handle number of clicked button ButtonHandle = WinParms(CurWinPtr, 16) ' test all buttons for match SELECT CASE ButtonHandle CASE xit2 ' exit xx = CloseWindow CASE TestWin ' test window button ' open a MODAL window to illustrate use of WinEvent's ' "time out" option for implementing an interrupt button. ' i strongly recommend that the window containing ' the interrupt button be MODAL (otherwise your user ' could attempt to mouse to another window and click buttons). ' since this will be a modal window, ' actions on other windows will be ignored until this win ' closed. thus, there is no need to deactivate buttons ' in the main window to prevent the user opening another ' instance of the test window. the fact that this is a modal ' window will insure that all objects in other windows ' are ignored. we will still have to deactivate some objects ' in this window that should be ignored. win1 = BlankWin(3, 3, 12, 40, 5, 15, 1, 0, 0, 2) ' i'll skip test for return code with error ' put some text into the window d = ShowWinText(2, 3, 14, "Interrupt Button Example") ' make some buttons w1strt = MakePushButton(7, 3, 7, "START", 15, 3, 1) w1int = MakePushButton(7, 13, 11, "INTERRUPT", 15, 3, 1) w1xit = MakePushButton(7, 27, 6, "EXIT", 15, 3, 1) ' initially, the interrupt button is inactive d = DeactivateButton(w1int, 0) ' i'll use a technique explained in SAMPLE04 to determine ' the handle of a static text field, and re-use that ' handle to dynamically change text in the window. ' this will show progress that is being made in the ' in the window while waiting for the interrupt button ' to be clicked. x = ShowWinText(4, 3, 15, "KNOWN VALUE") ' known text ' now scan all button text to find handle of above text timhan = -999 ' default handle number FOR i = 1 TO MaxButtons ' scan the entire data structure IF ButtonsText(i) = "KNOWN VALUE" THEN ' look for text timhan = i ' if match, save handle EXIT FOR ' terminate search END IF NEXT ' this problem should not occur ' (ie, could not find specific text in ButtonsText array), ' but as safety valve, i'll test for it. IF timhan = -999 THEN END ' at this point, timhan contains handle of text object ' that will by dynamically changed ButtonsText(timhan) = "" ' initialize text CALL ReShowInputField(timhan) ' update screen ButtonsData(timhan, 4) = LEN(a$) ' update length of area ' now return to main loop and wait for an event in the ' window just opened. END SELECT ' end of select for buttons in main END SELECT ' end of select for main window CASE win1 ' window where interrupt button is to be used ' only button events possible (no other objects defined) ' determine which button caused the event SELECT CASE WinParms(CurWinPtr, 16) CASE w1strt ' start button ' clicking the start button will begin a sample long running task. ' in my example, only the interrupt button will terminate ' the task. your code could implement a task that might terminate ' nornally if it ran long enough (like reading records from a ' file) or terminate immediately (if interrupt button is clicked). ' when the start button is clicked, the text label ' will be dynamically updated with the current time to simulate ' a task being done in a window while waiting for an ' interrupt button to be clicked. 'deactivate the start and exit buttons d = DeactivateButton(w1strt, 0) ' deactivate the start button d = DeactivateButton(w1xit, 0) ' deactivate the exit button 'activate the interrupt button d = ActivateButton(w1int, 0) ' activate the interrupt button ' to implement the technique of waiting for an interrupt button, ' a loop is used where some portion of the task is done ' (like reading one record from a file, scanning one directory, ' etc.), then WinEvent is called with the action parameter set to ' -999. this will cause WinEvent to "time out" and return ' after 0.5 sec if no event is detected, that is WinEvent will ' return control after 0.5 sec if the interrupt button was ' not clicked (if an event is detected, WinEvent will return as ' soon as the event is processed). when control is returned, just ' test to see if an event occured and if it was the interrupt ' button. if no event occured, continue with the loop and ' process the next portion of the task at hand. if the task ' completes nornally, or if you detect that the interrupt button ' was clicked when returning from WinEvent, then exit the loop. ' in this example, i just loop and modify the text field with ' current time (to simulate a long running task). ' when the INTERRUPT button is clicked, processing will stop. ' there is no test for nornal completion of the simulated task. DO ' the long running task loop ' simulate some work ButtonsText(timhan) = TIME$ 'place current time in array CALL ReShowInputField(timhan) 'update screen to show progress ButtonsData(timhan, 4) = LEN(a$) ' update length of area ' since the previous commands to update text on the screen ' are so fast, i've included the following SLEEP command ' to simulate the long running task's work within the loop. ' change the amount of time to sleep to see the effect. ' unfortunately, mouse clicks made while work is done outside ' of WinEvent are not "remembered" when WinEvent gets control. ' this is because WinEvent hides/shows the mouse cursor ' which resets the press counter. thus, if the loop you ' implement (with work and a call to WinEvent) takes a long ' time to get back to WinEvent each time, the effect will be ' that clicks on the interrupt button may seem to be ignored. ' your user will have to click repeatedly on the interrupt ' button (to make sure that at least one of those clicks ' occurs while EinEvent has control). to see this effect, ' set the wait time in the following SLEEP command to 5 ' or more. you'll have to click frequently on the interrupt ' button. sorry, i never said LangWin was perfect! ' to avoid this situation, try to keep the amount of work ' done in your loop as short (or efficient) as possible. ' add a SLEEP x command below to see effects of processing ' delays in the loop with WinEvent. aa = -999 ' set "time out" option for WinEvent x = WinEvent(aa) ' will return in 0.5 sec if no events occur ' loop until interrupt button is clicked LOOP UNTIL aa = 3 AND WinParms(CurWinPtr, 16) = w1int ' processing was interrupted ' activate start and exit buttons and deactivate interrupt button d = ActivateButton(w1strt, 0) ' activate the start button d = ActivateButton(w1xit, 0) ' activate the exit button d = DeactivateButton(w1int, 0) ' deactivate the interrupt button CASE w1xit ' exit button x = CloseWindow END SELECT ' end of section to process events in modal window END SELECT LOOP LOCATE 25, 1 CALL SetColor(15, 4) PRINT "HIT ANY KEY TO CONTINUE DEMO ..."; SLEEP LOCATE 25, 1 CALL SetColor(8, 15) PRINT STRING$(80, 178); END SUB ' ===================================================== ' returns type of video display ' ' return values: ' 1: black/white (could be EGA/VGA with monochrome) ' 2: CGA (with color) ' 3: EGA (with color) ' 4: VGA (with color) ' 5: MCGA (with color) ' 99: other ' FUNCTION VidType ' quick & dirty, check &h463 DEF SEG = 0 IF PEEK(&H463) = &HB4 THEN ' see if monochrome VidType = 1 EXIT FUNCTION END IF DEF SEG ' first try int 10h, function 1Ah InRegs.ax = &H1A00 CALL INTERRUPTX(&H10, InRegs, OutRegs) IF (OutRegs.ax AND &HFF) = &H1A THEN ' see if int 10h, funct 1Ah supported code = (OutRegs.bx AND &HFF) ' get display code SELECT CASE code CASE 1 ' MDA VidType = 1 CASE 2 ' CGA VidType = 2 CASE 4 ' EGA color VidType = 3 CASE 5 ' EGA b/w VidType = 1 CASE 7 ' VGA b/w VidType = 1 CASE 8 ' VGA color VidType = 4 CASE 10 ' MCGA color VidType = 5 CASE 11 ' MCGA b/w VidType = 1 CASE ELSE VidType = 99 ' other END SELECT EXIT FUNCTION ELSE ' now try int 10h, function 12h, sub-function 10h InRegs.ax = &H1200 InRegs.bx = &H10 CALL INTERRUPTX(&H10, InRegs, OutRegs) IF (OutRegs.bx AND &HFF00) = 1 THEN ' see if monochrome VidType = 1 EXIT FUNCTION END IF IF (OutRegs.bx AND &HFF) <> &H10 THEN ' see if BL reg changed VidType = 3 ' EGA (not sure why it couldn't be VGA too!) EXIT FUNCTION END IF VidType = 99 ' other (probably CGA or MDA) END IF END FUNCTION